home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / egavga.swg / 0165_Full 256-16 Colour Fading.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-03-26  |  5.6 KB  |  191 lines
  1. unit Fading;
  2. interface
  3. uses Crt;
  4.  
  5. type
  6.   Palette256 = array[0..255, 0..2] of Byte;
  7.   Palette16 = array[0..15, 0..2] of Byte;
  8.  
  9. procedure SetVGAPalette256(PalBuf: Palette256);
  10. procedure GetVGAPalette256(var PalBuf: Palette256);
  11. procedure SetVGAPalette16(PalBuf: Palette16);
  12. procedure GetVGAPalette16(var PalBuf: Palette16);
  13. procedure FadeOutScreen256;
  14. procedure FadeOutScreen16;
  15. procedure FadeInScreen256(PalToMake: Palette256);
  16. procedure FadeInScreen16(PalToMake: Palette16);
  17.  
  18. implementation
  19.  
  20. procedure SetVGAPalette256(PalBuf: Palette256);
  21. var
  22.   ColorOn : byte;
  23.  
  24. begin
  25.   Port[$3C8] := 0;
  26.   for ColorOn := 0 to 255 do
  27.       begin
  28.       Port[$3C9] := PalBuf[ColorOn, 0];
  29.       Port[$3C9] := PalBuf[ColorOn, 1];
  30.       Port[$3C9] := PalBuf[ColorOn, 2];
  31.       end;
  32. end; {Sets entire VGA palette.}
  33.  
  34. procedure GetVGAPalette256(var PalBuf: Palette256);
  35. var
  36.   ColorOn : byte;
  37.  
  38. begin
  39.   Port[$3C8] := 1;
  40.   for ColorOn := 0 to 255 do
  41.       begin
  42.       PalBuf[ColorOn, 0] := Port[$3C9];
  43.       PalBuf[ColorOn, 1] := Port[$3C9];
  44.       PalBuf[ColorOn, 2] := Port[$3C9];
  45.       end;
  46.   PalBuf[0, 0] := 0; {Color 0 doesn't read right.  I've tried}
  47.   PalBuf[0, 1] := 0; {Changing the $3C8 assigment and fooling with}
  48.   PalBuf[0, 2] := 0; {the loop, with no success.   Help!}
  49. end; {Reads entire VGA palette (except color 0)}
  50.  
  51. procedure SetVGAPalette16(PalBuf: Palette16);
  52. {I find this a convenient seperate procedure.  You may not need it.}
  53. var
  54.   ColorOn : byte;
  55.  
  56. begin
  57.   Port[$3C8] := 0;
  58.   for ColorOn := 0 to 15 do
  59.       begin
  60.       Port[$3C9] := PalBuf[ColorOn, 0];
  61.       Port[$3C9] := PalBuf[ColorOn, 1];
  62.       Port[$3C9] := PalBuf[ColorOn, 2];
  63.       end;
  64. end; {Sets entire palette for 16 colors}
  65.  
  66. procedure GetVGAPalette16(var PalBuf: Palette16);
  67. var
  68.   ColorOn : byte;
  69.  
  70. begin
  71.   Port[$3C8] := 1;
  72.   for ColorOn := 0 to 15 do
  73.       begin
  74.       PalBuf[ColorOn, 0] := Port[$3C9];
  75.       PalBuf[ColorOn, 1] := Port[$3C9];
  76.       PalBuf[ColorOn, 2] := Port[$3C9];
  77.       end;
  78.   PalBuf[0, 0] := 0; {Same deal as GetVGAPalette256.}
  79.   PalBuf[0, 1] := 0;
  80.   PalBuf[0, 2] := 0;
  81. end; {Reads entire 16 color palette}
  82.  
  83. procedure FadeOutScreen256;
  84.    var
  85.      Count        : word;
  86.      ColorOn      : byte;
  87.      PalToMake    : Palette256;
  88.      PaletteStuff : Palette256;
  89.  
  90.    begin
  91.    GetVGAPalette256(PaletteStuff);
  92.    PalToMake := PaletteStuff;
  93.    for Count := 63 downto 0 do
  94.        begin
  95.        Port[$3C8] := 0;
  96.        PaletteStuff := PalToMake;
  97.        Delay(1);
  98.        for ColorOn := 0 to 255 do
  99.            begin
  100.            PaletteStuff[ColorOn, 0] := (PaletteStuff[ColorOn, 0] * Count) div
  101. 63;           PaletteStuff[ColorOn, 1] := (PaletteStuff[ColorOn, 1] * Count)
  102. div 63;           PaletteStuff[ColorOn, 2] := (PaletteStuff[ColorOn, 2] *
  103. Count) div 63;           Port[$3C9] := PaletteStuff[ColorOn, 0];
  104.            Port[$3C9] := PaletteStuff[ColorOn, 1];
  105.            Port[$3C9] := PaletteStuff[ColorOn, 2];
  106.            end;
  107.        end;
  108.    end; {Fades out 256 color screen to black}
  109.  
  110. procedure FadeInScreen256(PalToMake: Palette256);
  111.    var
  112.      Count        : byte;
  113.      ColorOn      : byte;
  114.      PaletteStuff : Palette256;
  115.      FastPal      : Palette256;
  116.  
  117.    begin
  118.    GetVGAPalette256(PaletteStuff);
  119.    for Count := 0 to 63 do
  120.        begin
  121.        Port[$3C8] := 0;
  122.        PaletteStuff := PalToMake;
  123.        Delay(1);
  124.        for ColorOn := 0 to 255 do
  125.            begin
  126.            PaletteStuff[ColorOn, 0] := (PaletteStuff[ColorOn, 0] * Count) div
  127. 63;           PaletteStuff[ColorOn, 1] := (PaletteStuff[ColorOn, 1] * Count)
  128. div 63;           PaletteStuff[ColorOn, 2] := (PaletteStuff[ColorOn, 2] *
  129. Count) div 63;           Port[$3C9] := PaletteStuff[ColorOn, 0];
  130.            Port[$3C9] := PaletteStuff[ColorOn, 1];
  131.            Port[$3C9] := PaletteStuff[ColorOn, 2];
  132.            end;
  133.        end;
  134.    end; {Fades in 256 color screen from black to the given palette}
  135.  
  136.  procedure FadeOutScreen16;
  137.    var
  138.      Count        : word;
  139.      ColorOn      : byte;
  140.      PalToMake    : Palette16;
  141.      PaletteStuff : Palette16;
  142.  
  143.    begin
  144.    GetVGAPalette16(PaletteStuff);
  145.    PalToMake := PaletteStuff;
  146.    for Count := 63 downto 0 do
  147.        begin
  148.        Port[$3C8] := 0;
  149.        PaletteStuff := PalToMake;
  150.        Delay(5);
  151.        for ColorOn := 0 to 15 do
  152.            begin
  153.            PaletteStuff[ColorOn, 0] := (PaletteStuff[ColorOn, 0] * Count) div
  154. 63;           PaletteStuff[ColorOn, 1] := (PaletteStuff[ColorOn, 1] * Count)
  155. div 63;           PaletteStuff[ColorOn, 2] := (PaletteStuff[ColorOn, 2] *
  156. Count) div 63;           Port[$3C9] := PaletteStuff[ColorOn, 0];
  157.            Port[$3C9] := PaletteStuff[ColorOn, 1];
  158.            Port[$3C9] := PaletteStuff[ColorOn, 2];
  159.            end;
  160.        end;
  161.    end; {Fades out the 16 color screen to black}
  162.  
  163.  
  164. procedure FadeInScreen16(PalToMake: Palette16);
  165.    var
  166.      Count        : byte;
  167.      ColorOn      : byte;
  168.      PaletteStuff : Palette16;
  169.      FastPal      : Palette16;
  170.  
  171.    begin
  172.    GetVGAPalette16(PaletteStuff);
  173.    for Count := 0 to 63 do
  174.        begin
  175.        Port[$3C8] := 0;
  176.        PaletteStuff := PalToMake;
  177.        Delay(5);
  178.        for ColorOn := 0 to 15 do
  179.            begin
  180.            PaletteStuff[ColorOn, 0] := (PaletteStuff[ColorOn, 0] * Count) div
  181. 63;           PaletteStuff[ColorOn, 1] := (PaletteStuff[ColorOn, 1] * Count)
  182. div 63;           PaletteStuff[ColorOn, 2] := (PaletteStuff[ColorOn, 2] *
  183. Count) div 63;           Port[$3C9] := PaletteStuff[ColorOn, 0];
  184.            Port[$3C9] := PaletteStuff[ColorOn, 1];
  185.            Port[$3C9] := PaletteStuff[ColorOn, 2];
  186.            end;
  187.        end;
  188.    end;
  189.  
  190. end.
  191.